home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / rbbsbas.zip / RBBSSUB1.BAS < prev    next >
BASIC Source File  |  1988-10-02  |  53KB  |  1,567 lines
  1. ' $linesize:132
  2. ' $title: 'RBBS-SUB1.BAS CPC17-1A, Copyright 1986-88 by D. Thomas Mack'
  3. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB1.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: September 18, 1988
  7. '  Subsequent Releases.:
  8. '  Copyright ..........: 1986, 1987, 1988
  9. '  Purpose.............:
  10. '     Subprorams that require error trapping are incorporated
  11. '     within RBBSSUB1.BAS as separately callable subroutines
  12. '     in order to free up as much code as possible within
  13. '     the 64K code segment used by RBBS-PC.BAS.
  14. '  Parameters..........: Most parameters are passed via a COMMON statement.
  15. '
  16. ' Subroutine  Line               Function of Subroutine
  17. '   Name     Number
  18. '  CHANGEDIR  20103   Change subdirectory
  19. '  CHECKINT   58360   Check input is valid integer
  20. '  FINDFREE   52000   Find amount of space on the upload disk drive
  21. '  FINDIT     20221   Find if a file exists on a device
  22. '  FINDUSER   12610   Find a user in the USERS file
  23. '  FLUSHCOM   20311   Read all characters in the communications port
  24. '  GETCOM      1420   Read a character from the communications port
  25. '  GETPASWD   58280   Read RBBS-PC's "PASSWORD" file
  26. '  GETWRK     58330   Read record from file number 2
  27. '  KILLWORK   58260   Delete a RBBS-PC "WORK" file
  28. '  NETBIOS    29900   Lock/Unlock NETBIOS semaphore files
  29. '  OPENCOM      200   Open communications port (number 3)
  30. '  OPENFMS    58190   Open the upload management system directory
  31. '  OPENOUTW   28220   Open RBBS-PC's "WORK" file (number 2) for output
  32. '  OPENRSEQ    1479   Open a sequential file (number 2) for random I/O
  33. '  OPENUSER    9400   Open the USER file (number 5)
  34. '  OPENWORK   58000   Open RBBS-PC's work file (number 2)
  35. '  OPENWRKA   58340   Open RBBS-PC's "WORK" file (number 2) for append
  36. '  PRINTIT    13674   Print line on the local PC running RBBS-PC printer
  37. '  PRINTWRK   58320   Print string to file #2 w/o CR/LF
  38. '  PRNTWRKA   58350   Print string to file #2 with CR/LF
  39. '  PUTCOM     59650   Write to the communications port
  40. '  PUTWORK    59660   Write to work file randomly
  41. '  READANY    58310   Read file number 2 into A$
  42. '  READDEF      117   Read configuration file
  43. '  READDIR    58290   Read entire lines
  44. '  READPARMS  58300   Read certain number of parameters from file 2
  45. '  SETCALL      108   Find where next callers record is
  46. '  UPDATEC    43050   Update the caller's file with elasped session time
  47. '  UPDTCALR   13665   Update to the caller's file
  48. '
  49. '  $INCLUDE: 'RBBS-VAR.BAS'
  50. '
  51. ' $SUBTITLE: 'SETCALL - subroutine to find last callers rec'
  52. ' $PAGE
  53. '
  54. '  SUBROUTINE NAME    -- SETCALL
  55. '
  56. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  57. '
  58. '  OUTPUT PARAMETERS  --  CALLERS.FILE.INDEX!
  59. '
  60. '  SUBROUTINE PURPOSE --  TO FIND WHERE TO LEAVE OFF ON CALLERS FILE
  61. '
  62. 108 SUB SETCALL STATIC
  63.     ON ERROR GOTO 65000
  64.     IF PREV.CALLERS$ = CALLERS.FILE$ OR CALLERS.FILE$ = "" THEN _
  65.        EXIT SUB
  66.     PREV.CALLERS$ = CALLERS.FILE$
  67.     CALLERS.FILE.INDEX! = 1
  68.     CALL FINDIT (CALLERS.FILE$)
  69.     CLOSE 2
  70.     CLOSE 4
  71.     IF SHARE.IT THEN _
  72.        OPEN CALLERS.FILE$ LOCK WRITE AS #4 LEN=64 _
  73.     ELSE OPEN "R",4,CALLERS.FILE$,64
  74.     FIELD 4,64 AS CALLERS.RECORD$
  75.     IF OK AND LOF(4) > 0 THEN _
  76.        CALLERS.FILE.INDEX! = LOF(4) / 64
  77.     IF CALLERS.FILE.INDEX! < 1 THEN _
  78.        CALLERS.FILE.INDEX! = 0
  79.     B$ = STRING$(13,0)
  80. 110 GET 4,CALLERS.FILE.INDEX!
  81.     IF EC > 0 THEN _
  82.        EC = 0 : _
  83.        CALLERS.FILE.INDEX! = 0 : _
  84.        EXIT SUB
  85.     IF LEFT$(CALLERS.RECORD$,13) = B$ THEN _
  86.        CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! - 1 : _
  87.        GOTO 110
  88.     END SUB
  89. '
  90. ' $SUBTITLE: 'READDEF - subroutine to read RBBS-PC.DEF file'
  91. ' $PAGE
  92. '
  93. '  SUBROUTINE NAME    -- READDEF
  94. '
  95. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  96. '                         CONFIG.FILENAME$            NAME OF RBBS-PC.DEF FILE
  97. '                         SUBROUTINE.PARAMETER = -62  ONLY READ THE .DEF FILE
  98. '
  99. '  OUTPUT PARAMETERS  --  ALL THE RBBS-PC.DEF PARAMETERS
  100. '
  101. '  SUBROUTINE PURPOSE --  TO READ THE PARAMETERS FROM THE RBBS-PC.DEF FILE
  102.      SUB READDEF (CONFIG.FILE$) STATIC
  103.      ON ERROR GOTO 65000
  104. '
  105. ' **** OPEN AND READ RBBS-PC CONFIGURATION DEFINITIONS ****
  106. '
  107. 117 IF SUBROUTINE.PARAMETER <> -62 THEN _
  108.        IF PREV.READ$ = CONFIG.FILE$ THEN _
  109.           EXIT SUB _
  110.        ELSE PREV.READ$ = CONFIG.FILE$
  111.     CLOSE 2
  112.     BULLETIN.SAVE$ = BULLETIN.MENU$
  113.     OPEN "I",2,CONFIG.FILE$
  114.     CURRENT.DEF$ = CONFIG.FILE$
  115.     INPUT #2,DF$, _
  116.              DOWNLOAD.DRIVES$, _
  117.              SYSOP.PASSWORD.1$, _
  118.              SYSOP.PASSWORD.2$, _
  119.              SYSOP.FIRST.NAME$, _
  120.              SYSOP.LAST.NAME$, _
  121.              REQUIRED.RINGS, _
  122.              START.OFFICE.HOURS, _
  123.              END.OFFICE.HOURS, _
  124.              MINUTES.PER.SESSION!, _
  125.              DF, _
  126.              DF, _
  127.              UPLOAD.DIRECTORY$, _
  128.              EXPERT.USER, _
  129.              ACTIVE.BULLETINS, _
  130.              PROMPT.BELL, _
  131.              DF, _
  132.              MENUS.CAN.PAUSE, _
  133.              MENU$(1), _
  134.              MENU$(2), _
  135.              MENU$(3), _
  136.              MENU$(4), _
  137.              MENU$(5), _
  138.              MENU$(6), _
  139.              CONFERENCE.MENU$, _
  140.              DF, _
  141.              WELCOME.INTERRUPTABLE, _
  142.              REMIND.FILE.TRANSFERS, _
  143.              PAGE.LENGTH, _
  144.              MAX.MESSAGE.LINES.DEF, _
  145.              DOORS.AVAILABLE, _
  146.              DF$
  147.     IF CONFERENCE.MODE THEN _
  148.        INPUT #2,DF$,_
  149.                 DF$_
  150.     ELSE INPUT #2,MAIN.MESSAGE.FILE$, _
  151.                   MAIN.MESSAGE.BACKUP$
  152.     INPUT #2, X$, _
  153.               COMMENTS.FILE$, _
  154.               MAIN.USER.FILE$, _
  155.               WELCOME.FILE$, _
  156.               NEWUSER.FILE$, _
  157.               MAIN.DIRECTORY.EXTENTION$
  158.     IF X$ <> "" THEN _
  159.        CALLERS.FILE$ = X$
  160.     IF CONFERENCE.MODE THEN _
  161.        INPUT #2, DF$ _
  162.     ELSE INPUT #2, COM.PORT$
  163.     INPUT #2, BULLETINS.OPTIONAL, _
  164.               MODEM.INIT.COMMAND$, _
  165.               RTS$, _
  166.               DF, _
  167.               FG, _
  168.               BG, _
  169.               BORDER
  170.     IF CONFERENCE.MODE THEN _
  171.        INPUT #2, DF$, _
  172.                  DF$ _
  173.     ELSE INPUT #2, RBBS.BAT$ , _
  174.                    RCTTY.BAT$
  175.     INPUT #2,OMIT.MAIN.DIRECTORY$, _
  176.              FIRST.NAME.PROMPT$, _
  177.              HELP$(3), _
  178.              HELP$(4), _
  179.              HELP$(7), _
  180.              HELP$(9), _
  181.              BULLETIN.MENU$, _
  182.              BULLETIN.PREFIX$, _
  183.              DF$, _
  184.              MESSAGE.REMINDER, _
  185.              REQUIRE.NON.ASCII, _
  186.              ASK.EXTENDED.DESC, _
  187.              MAXIMUM.NUMBER.OF.NODES, _
  188.              NETWORK.TYPE, _
  189.              RECYCLE.TO.DOS, _
  190.              DF, _
  191.              DF, _
  192.              TRASHCAN.FILE$
  193.     INPUT #2,MINIMUM.LOGON.SECURITY, _
  194.              DEFAULT.SECURITY.LEVEL, _
  195.              SYSOP.SECURITY.LEVEL, _
  196.              FILESEC.FILE$, _
  197.              SYSOP.MENU.SECURITY.LEVEL, _
  198.              CONFMAIL.LIST$, _
  199.              MAXIMUM.VIOLATIONS, _
  200.              OPT.SEC(50), _   ' SECURITY FOR SYSOP COMMANDS 1
  201.              OPT.SEC(51), _
  202.              OPT.SEC(52), _
  203.              OPT.SEC(53), _
  204.              OPT.SEC(54), _
  205.              OPT.SEC(55), _
  206.              OPT.SEC(56), _   ' SYSOP 7
  207.              PASSWORDS.FILE$, _
  208.              MAXIMUM.PASSWORD.CHANGES, _
  209.              MINIMUM.SECURITY.FOR.TEMP.PASSWORD, _
  210.              OVERWRITE.SECURITY.LEVEL, _
  211.              DOORS.TERMINAL.TYPE, _
  212.              MAX.PER.DAY
  213.     INPUT #2,OPT.SEC(1), _   ' SECURITY FOR MAIN MENU COMMANDS 1
  214.              OPT.SEC(2), _
  215.              OPT.SEC(3), _
  216.              OPT.SEC(4), _
  217.              OPT.SEC(5), _
  218.              OPT.SEC(6), _
  219.              OPT.SEC(7), _
  220.              OPT.SEC(8), _
  221.              OPT.SEC(9), _
  222.              OPT.SEC(10), _
  223.              OPT.SEC(11), _
  224.              OPT.SEC(12), _
  225.              OPT.SEC(13), _
  226.              OPT.SEC(14), _
  227.              OPT.SEC(15), _
  228.              OPT.SEC(16), _
  229.              OPT.SEC(17), _
  230.              OPT.SEC(18), _   ' MAIN COMMAND 18
  231.              MIN.NEWCALLER.BAUD, _
  232.              WAIT.BEFORE.DISCONNECT
  233.     INPUT #2,OPT.SEC(19), _      ' Security for FILE COMMANDS 1
  234.              OPT.SEC(20), _
  235.              OPT.SEC(21), _
  236.              OPT.SEC(22), _
  237.              OPT.SEC(23), _
  238.              OPT.SEC(24), _
  239.              OPT.SEC(25), _
  240.              OPT.SEC(26), _      ' FILE COMMAND 8
  241.              OPT.SEC(27), _      ' SECURITY FOR UTILITY COMMANDS 1
  242.              OPT.SEC(28), _
  243.              OPT.SEC(29), _
  244.              OPT.SEC(30), _
  245.              OPT.SEC(31), _
  246.              OPT.SEC(32), _
  247.              OPT.SEC(33), _
  248.              OPT.SEC(34), _
  249.              OPT.SEC(35), _
  250.              OPT.SEC(36), _
  251.              OPT.SEC(37), _
  252.              OPT.SEC(38), _   ' UTIL COMMAND 12
  253.              OPT.SEC(46), _   ' SECURITY FOR GLOBAL COMMANDS 1
  254.              OPT.SEC(47), _
  255.              OPT.SEC(48), _
  256.              OPT.SEC(49), _   ' GLOBAL 4
  257.              UPLOAD.TIME.FACTOR!, _
  258.              COMPUTER.TYPE, _
  259.              REMIND.PROFILE, _
  260.              RBBS.NAME$, _
  261.              COMMANDS.BETWEEN.RINGS, _
  262.              MNP.SUPPORT, _
  263.              PAGING.PRINTER.SUPPORT$, _
  264.              MODEM.INIT.BAUD$
  265.              IF EC > 0 THEN _
  266.                 EXIT SUB
  267. 118 INPUT #2, TURN.PRINTER.OFF,_    ' Turn printer off each recycle
  268.               DIRECTORY.PATH$, _    ' Where dir files are stored
  269.               MIN.SEC.TO.VIEW, _
  270.               LIMIT.SEARCH.TO.FMS, _
  271.               DEFAULT.CATEGORY.CODE$, _
  272.               DIR.CATEGORY.FILE$, _
  273.               NEW.FILES.CHECK, _
  274.               MAX.DESC.LEN, _
  275.               SHOW.SECTION, _
  276.               COMMANDS.IN.PROMPT, _
  277.               NEWUSER.SETS.DEFAULTS, _
  278.               HELP.PATH$, _
  279.               HELP.EXTENSION$, _
  280.               MAIN.COMMANDS$, _
  281.               FILE.COMMANDS$, _
  282.               UTIL.COMMANDS$, _
  283.               GLOBAL.COMMANDS$, _
  284.               SYSOP.COMMANDS$
  285.     INPUT #2, RECYCLE.WAIT, _
  286.               OPT.SEC(39), _       ' SECURITY FOR LIBRARY COMMANDS 1
  287.               OPT.SEC(40), _
  288.               OPT.SEC(41), _
  289.               OPT.SEC(42), _
  290.               OPT.SEC(43), _
  291.               OPT.SEC(44), _
  292.               OPT.SEC(45), _       ' LIBRARY COMMANDS 7
  293.               LIBRARY.DRIVE$, _
  294.               LIBRARY.DIRECTORY.PATH$, _
  295.               LIBRARY.DIRECTORY.EXTENTION$, _
  296.               LIBRARY.WORK.DISK.PATH$, _
  297.               LIBRARY.MAX.DISK, _
  298.               LIBRARY.MAX.DIRECTORY, _
  299.               LIBRARY.MAX.SUBDIR, _
  300.               LIBRARY.SUBDIR.PREFIX$, _
  301.               LIBRARY.ARCHIVE.PATH$, _
  302.               LIBRARY.ARCHIVE.PROGRAM$, _
  303.               LIBRARY.COMMANDS$
  304. '
  305. ' *****  ESTABLISH COMMUNICATION PORT REGISTERS AND COMMANDS   ****
  306. ' *****     GET DOS SUB-DIRECTORY RBBS-PC OPTIONS              ****
  307. '
  308.     INPUT #2, UPLOAD.PATH$, _              ' Where upl dir goes
  309.               MAIN.FMS.DIRECTORY$, _       ' Shared dir in FMS
  310.               ANS.MENU$, _
  311.               REQUIRED.QUESTIONNAIRE$,_
  312.               REMEMBER.NEW.USERS,_
  313.               SURVIVE.NOUSER.ROOM,_
  314.               PROMPT.HASH$,_
  315.               START.HASH,_
  316.               LEN.HASH,_
  317.               PROMPT.INDIV$,_
  318.               START.INDIV,_
  319.               LEN.INDIV
  320.     INPUT #2, BYPASS.MSGS, _
  321.               MUSIC, _
  322.               RESTRICT.BY.DATE, _
  323.               DAYS.TO.WARN, _
  324.               DAYS.IN.REGISTRATION.PERIOD, _
  325.               CALLBACK.VERIFICATION, _
  326.               RESTRICT.VALID.CMDS, _
  327.               NEW.USER.DEFAULT.MODE, _
  328.               NEW.USER.LINE.FEEDS, _
  329.               NEW.USER.NULLS, _
  330.               NEW.USER.BELL, _
  331.               NEW.USER.CASE, _
  332.               NEW.USER.MARGINS, _
  333.               WRAP.CALLERS.FILE$, _
  334.               REDIRECT.IO.METHOD, _
  335.               GO.TO.SHELL, _
  336.               HALT.ON.ERROR, _
  337.               NEW.PUBLIC.MSGS.SECURITY, _
  338.               NEW.PRIVATE.MSGS.SECURITY, _
  339.               SECURITY.NEEDED.TO.CHANGE.MSGS, _
  340.               SL.CATEGORIZE.UPLOADS, _
  341.               BAUDOT, _
  342.               TIME.TO.DROP.TO.DOS, _
  343.               EXPIRED.SECURITY, _
  344.               DTR.DROP.DELAY, _
  345.               ASK.IDENTITY, _
  346.               USE.EXTERNAL.XMODEM, _
  347.               BUFFER.SIZE, _
  348.               MLCOM, _
  349.               SHOOT.YOURSELF, _
  350.               F7.MESSAGE$, _
  351.               NEW.USER.DEFAULT.PROTOCOL$, _
  352.               NEW.USER.GRAPHICS$, _
  353.               NET.MAIL$, _
  354.               MASTER.DIRECTORY.NAME$, _
  355.               PROTO.DEF$, _
  356.               UPCAT.HELP$, _
  357.               ALWAYS.STREW.TO$, _
  358.               LAST.NAME.PROMPT$
  359.     INPUT #2, PERSONAL.DRVPATH$, _
  360.               PERSONAL.DIR$, _
  361.               PERSONAL.BEGIN, _
  362.               PERSONAL.LEN, _
  363.               PERSONAL.PROTOCOL$, _
  364.               PERSONAL.CONCAT , _
  365.               PRIVATE.READ.SEC, _
  366.               PUBLIC.READ.SEC, _
  367.               SEC.CHANGE.MSG, _
  368.               KEEP.INIT.BAUD, _
  369.               MAIN.PUI$, _
  370.               DEFAULT.ECHOER$, _
  371.               HOST.ECHO.ON$, _
  372.               HOST.ECHO.OFF$, _
  373.               SWITCH.BACK, _
  374.               DEFAULT.LINE.ACK$, _
  375.               ALTDIR.EXTENSION$, _
  376.               DIRECTORY.PREFIX$
  377.     IF CONFERENCE.MODE THEN _
  378.        INPUT #2, DF, _
  379.                  DF, _
  380.                  DF _
  381.     ELSE INPUT #2, DF,_
  382.                    MODEM.INIT.WAIT.TIME, _
  383.                    MODEM.COMMAND.DELAY.TIME
  384.     INPUT #2, TURBO.RBBS, _
  385.               SUBDIR.COUNT, _
  386.               DF, _
  387.               UPLOAD.TO.SUBDIR, _
  388.               DF, _
  389.               UPLOAD.SUBDIR$, _
  390.               MIN.OLDCALLER.BAUD, _
  391.               USE.EXTERNAL.YMODEM, _
  392.               DISKFULL.GO.OFFLINE, _
  393.               EXTENDED.LOGGING
  394.      IF CONFERENCE.MODE THEN _
  395.         INPUT #2, DF$, _
  396.                   DF$, _
  397.                   DF$, _
  398.                   DF$ _
  399.      ELSE INPUT #2, MODEM.RESET.COMMAND$, _
  400.                     MODEM.COUNT.RINGS.COMMAND$, _
  401.                     MODEM.ANSWER.COMMAND$, _
  402.                     MODEM.GO.OFFHOOK.COMMAND$
  403.      INPUT #2,DISK.FOR.DOS$, _
  404.               DUMB.MODEM, _
  405.               COMMENTS.AS.MESSAGES
  406.      IF CONFERENCE.MODE THEN _
  407.         INPUT #2, DF, _
  408.                   DF, _
  409.                   DF, _
  410.                   DF, _
  411.                   DF, _
  412.                   DF _
  413.      ELSE INPUT #2, LSB,_
  414.                     MSB,_
  415.                     LINE.CONTROL.REGISTER,_
  416.                     MODEM.CONTROL.REGISTER,_
  417.                     LINE.STATUS.REGISTER,_
  418.                     MODEM.STATUS.REGISTER
  419.      INPUT #2,KEEP.TIME.CREDITS, _
  420.               XON.XOFF, _
  421.               ALLOW.CALLER.TURBO, _
  422.               USE.DEVICE.DRIVER$, _
  423.               PRELOG$, _
  424.               NEW.USER.QUESTIONNAIRE$, _
  425.               EPILOG$, _
  426.               REGISTRATION.PROGRAM$, _
  427.               QUES.PATH$, _
  428.               USER.LOCATION$, _
  429.               DF$, _
  430.               DF$, _
  431.               DF$, _
  432.               ENFORCE.UPLOAD.DOWNLOAD.RATIOS, _
  433.               SIZE.OF.STACK, _
  434.               SECURITY.EXEMPT.FROM.EPILOG, _
  435.               USE.BASIC.WRITES, _
  436.               DOSANSI, _
  437.               ESCAPE.INSECURE, _
  438.               USE.DIR.ORDER, _
  439.               ADD.DIR.SECURITY, _
  440.               MAX.EXTENDED.LINES, _
  441.               ORIG.COMMANDS$
  442.      INPUT #2,LOGON.MAIL.LEVEL$, _
  443.               MACRO.DRVPATH$, _
  444.               MACRO.EXTENSION$, _
  445.               EMPHASIZE.ON.DEF$, _
  446.               EMPHASIZE.OFF.DEF$, _
  447.               FG.1.DEF$, _
  448.               FG.2.DEF$, _
  449.               FG.3.DEF$, _
  450.               FG.4.DEF$, _
  451.               SECVIO.HLP$, _
  452.               FOSSIL, _
  453.               MAX.CARRIER.WAIT, _
  454.               DF, _
  455.               SMART.TEXT, _
  456.               TIME.LOCK, _
  457.               WRITE.BUF.DEF, _
  458.               DF, _
  459.               DF, _
  460.               DF, _
  461.               AUTOPAGE.DEF$
  462.      IF EC > 0 THEN _
  463.         EXIT SUB
  464.      CALL EDITDEF
  465.      END SUB
  466. ' $SUBTITLE: 'OPENCOM - subroutine to open the communications port'
  467. ' $PAGE
  468. '
  469. '  SUBROUTINE NAME    -- OPENCOM
  470. '
  471. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  472. '                       BAUD.RATE$                 BAUD TO OPEN MODEM
  473. '                       PARITY$                    PARITY TO OPEN MODEM
  474. '
  475. '  OUTPUT PARAMETERS -- BAUD.TEST                  BAUD RATE TO SET RS232 AT
  476. '
  477. '  SUBROUTINE PURPOSE -- TO OPEN THE COMMUNICATIONS PORT.
  478. '
  479.       SUB OPENCOM(BAUD.RATE$,PARITY$) STATIC
  480.       ON ERROR GOTO 65000
  481. 200 IF FOSSIL THEN _
  482.        IF RTS$ = "YES" THEN _
  483.           FLOW.CONTROL = TRUE : _
  484.           FLOW% = &H00F2 : _
  485.           CALL FOSFLOWCTL(COMPORT%,FLOW%)
  486.     IF INSTR(PARITY$,"N") THEN _
  487.        PARITY% = 2 : _                                     ' NO PARITY
  488.        DATABITS% = 3 : _                                   ' 8 DATA BITS
  489.        STOPBITS% = 0 _                                     ' 1 STOP BIT
  490.     ELSE PARITY% = 3 : _                                   ' EVEN PARITY
  491.          DATABITS% = 2 : _                                 ' 7 DATA BITS
  492.          STOPBITS% = 0                                     ' 1 STOP BIT
  493.     IF FOSSIL THEN _
  494.        COMSPEED% = VAL(BAUD.RATE$) : _
  495.        CALL FOSSPEED(COMPORT%,COMSPEED%,PARITY%,DATABITS%,STOPBITS%) : _
  496.        EXIT SUB
  497.     CLOSE 3
  498.     IF RTS$ = "YES" THEN _
  499.        FLOW.CONTROL = TRUE : _
  500.        X$ = ",CS,CD,DS" _
  501.     ELSE X$ = ",RS,CD,DS"
  502.     OPEN COM.PORT$ + ":" + BAUD.RATE$ + PARITY$ + X$ AS #3
  503. '
  504. ' *****************************************************************************
  505. ' *  RAISE THE RTS SIGNAL IF THE MODEM USES RTS FOR MODEM FLOW CONTROL (ONCE  *
  506. ' *  IT IS RAISED, IT WILL STAY UP UNTIL THE REGISTER IS CLEARED OUT).        *
  507. ' *****************************************************************************
  508. '
  509.     END SUB
  510. ' $SUBTITLE: 'GETCOM -- subroutine reads a char. from  comm. port'
  511. ' $PAGE
  512. '
  513. '  SUBROUTINE NAME    -- GETCOM
  514. '
  515. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  516. '                          STNG$       STRING TO READ A CHARACTER INTO FROM
  517. '                                      THE COMMUNICATIONS PORT (FILE #3)
  518. '
  519. '  OUTPUT PARAMETERS  --   STNG$
  520. '
  521. '  SUBROUTINE PURPOSE -- READS A CHARACTER FROM FROM THE COMMUNICATIONS PORT.
  522. '
  523.       SUB GETCOM (STRNG$) STATIC
  524.       ON ERROR GOTO 65000
  525. 1420 IF FOSSIL THEN _
  526.         CALL FOSRXCHAR(COMPORT%,CHAR%) : _
  527.         STRNG$ = CHR$(CHAR%) _
  528.      ELSE STRNG$ = INPUT$(1,3)
  529. 1421 IF EC = 57 THEN _
  530.         LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  531.         EC = 0 : _
  532.         GOTO 1420
  533.      END SUB
  534. ' $SUBTITLE: 'OPENRSEQ  - subroutine open sequential file randomly'
  535. ' $PAGE
  536. '
  537. '  SUBROUTINE NAME    -- OPENRSEQ
  538. '
  539. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  540. '                        FILNAME$      NAME OF SEQUENTIAL FILE TO OPEN AS #2
  541. '
  542. '  OUTPUT PARAMETERS  -- NUM.RECS      NUMBER OF 128-BYTE RECORDS IN THE FILE
  543. '                        LEN.LAST.REC  NUMBER OF BYTES IN THE LAST RECORD (IT
  544. '                                      MAY BE LESS THAN OR EQUAL TO 128).
  545. '
  546. '  SUBROUTINE PURPOSE -- SUBROUTINE TO OPEN A SEQUENTIAL FILE AS FILE # 2 AND
  547. '                        READ IT RANDOMLY.
  548. '
  549.      SUB OPENRSEQ (FILNAME$,NUM.RECS,LEN.LAST.REC,REC.LEN) STATIC
  550. 1479 ON ERROR GOTO 65000
  551.      CLOSE 2
  552. 1480 EC = 0
  553. 1481 IF SHARE.IT THEN _
  554.         OPEN FILNAME$ FOR RANDOM SHARED AS #2 LEN=REC.LEN _
  555.      ELSE OPEN "R",2,FILNAME$,REC.LEN
  556.      IF EC = 52 THEN _
  557.         GOTO 1480
  558.      FIELD #2, REC.LEN AS DOWNLOAD.RECORD$
  559.      I# = LOF(2)
  560.      NUM.RECS = FIX(I#/REC.LEN)
  561.      LEN.LAST.REC = I# - CDBL(NUM.RECS) * REC.LEN
  562.      IF LEN.LAST.REC > 0 THEN _
  563.         NUM.RECS = NUM.RECS + 1 _
  564.      ELSE LEN.LAST.REC = REC.LEN
  565.   END SUB
  566. ' $SUBTITLE: 'OPENUSER - subroutine to open the users file as #5'
  567. ' $PAGE
  568. '
  569. '  SUBROUTINE NAME    -- OPENUSER
  570. '
  571. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  572. '                        SHARE.IT
  573. '
  574. '  OUTPUT PARAMETERS  -- ACTIVE.USER.FILE$
  575. '                        CITY.STATE$
  576. '                        ELAPSED.TIME$
  577. '                        LAST.DATE.TIME.ON$
  578. '                        LAST.REC            # OF LAST RECORD IN USERS FILE
  579. '                        LIST.NEW.DATE$
  580. '                        MACHINE.TYPE$
  581. '                        PASSWORD$
  582. '                        SECURITY.LEVEL$
  583. '                        USER.DOWNLOADS$
  584. '                        USER.NAME$
  585. '                        USER.OPTIONS$
  586. '                        USER.RECORD$
  587. '                        USER.UPLOADS$
  588. '
  589. '  SUBROUTINE PURPOSE -- OPEN THE USER FILE AS FILE # 5
  590. '
  591.       SUB OPENUSER (LAST.REC) STATIC
  592.       ON ERROR GOTO 65000
  593. '
  594. ' ****  OPEN AND DEFINE USER FILE RECORD VARIABLES  ****                              *
  595. '
  596. 9400 CLOSE 5
  597.      IF SHARE.IT THEN _
  598.         OPEN ACTIVE.USER.FILE$ FOR RANDOM SHARED AS #5 LEN=128 _
  599.      ELSE OPEN "R",5,ACTIVE.USER.FILE$,128
  600.      I# = LOF(5)
  601.      LAST.REC = FIX(I#/128)
  602.      FIELD 5,31 AS USER.NAME$, _
  603.              15 AS PASSWORD$, _
  604.               2 AS SECURITY.LEVEL$, _
  605.              14 AS USER.OPTIONS$,  _
  606.              24 AS CITY.STATE$, _
  607.               3 AS MACHINE.TYPE$, _
  608.               4 AS TODAY.DL$, _
  609.               4 AS TODAY.BYTES$, _
  610.               4 AS DL.BYTES$, _
  611.               4 AS UL.BYTES$, _
  612.              14 AS LAST.DATE.TIME.ON$, _
  613.               3 AS LIST.NEW.DATE$, _
  614.               2 AS USER.DOWNLOADS$, _
  615.               2 AS USER.UPLOADS$, _
  616.               2 AS ELAPSED.TIME$
  617.      FIELD 5,128 AS USER.RECORD$
  618.      END SUB
  619. ' $SUBTITLE: 'FINDUSER - subroutine to search users file for a name'
  620. ' $PAGE
  621. '
  622. '  SUBROUTINE NAME    -- FINDUSER
  623. '
  624. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  625. '                        HASH.TO.LOOK.FOR$    STRING TO SEARCH FOR IN USERS
  626. '                        INDIV.TO.LOOK.FOR$   STRING TO USE TO INDIVIDUATE
  627. '                                             USERS WITH SAME HASH
  628. '                        START.HASH.POS       WHERE HASH FIELD STARTS IN THE
  629. '                                             "USERS" FILE
  630. '                        LEN.HASH.FIELD       LENGTH OF THE HASH FIELD
  631. '                        START.INDIV.POS      WHERE THE FIELD TO DISTINGUISH
  632. '                                             AMONG USERS (I.E. WITH THE SAME
  633. '                                             NAME) STARTS IN THE "USERS" FILE
  634. '                                             (SET TO 0 IF NONE TO BE USED)
  635. '                        LEN.INDIV.FIELD      LENGTH OF FIELD TO DISTINGUISH
  636. '                                             AMONG USERS
  637. '                        MAX.POSITION         HIGHEST RECORD TO SEARCH OR USE
  638. '
  639. '  NOTE: THIS SUBROUTINE ASSUMES THE "USERS" FILE IS OPEN AS FILE 2.
  640. '
  641. '  OUTPUT PARAMETERS  -- WHETHER.FOUND        SET TO "TRUE" IF USER WAS FOUND
  642. '                                             OTHERWISE IT IS "FALSE"
  643. '                        POS.TO.USE           NUMBER OF THE "USERS" RECORD THAT
  644. '                                             BELONGS TO THE USER (IF FOUND) OR
  645. '                                             TO USE FOR THE USER (IF THE USER
  646. '                                             WASN'T FOUND)
  647. '                        POS.TO.RECLAIM       SET TO 0 IF THE RECORD NUMBER
  648. '                                             SELECTED FOR THIS USER HAS NEVER
  649. '                                             BEEN USED.
  650. '
  651. '  SUBROUTINE PURPOSE -- TO SEARCH THE "USERS" FILE AND DETERMINE THE RECORD
  652. '                        NUMBER TO USE FOR THE CALLER IN THE "USERS" FILE.
  653. '
  654.       SUB FINDUSER (HASH.TO.LOOK.FOR$,INDIV.TO.LOOK.FOR$,START.HASH.POS,_
  655.                     LEN.HASH.FIELD,START.INDIV.POS,LEN.INDIV.FIELD,_
  656.                     MAX.POSITION,WHETHER.FOUND,_
  657.                     POS.TO.USE,POS.TO.RECLAIM) STATIC
  658.       ON ERROR GOTO 65000
  659.       EC = 0
  660.       WHETHER.FOUND = 0
  661.       IF HASH.TO.LOOK.FOR$ = SPACE$(LEN(HASH.TO.LOOK.FOR$)) THEN _
  662.          EXIT SUB
  663.       EMPTY.REC$ = SPACE$(LEN.HASH.FIELD)
  664.       EMPTY.INDIV$ = SPACE$(LEN.INDIV.FIELD)
  665.       NEWUSER$ = LEFT$("NEWUSER  ",LEN.HASH.FIELD + 2)
  666.       FIELD 5, 128 AS FILLER$
  667.       X$ = HASH.TO.LOOK.FOR$ + SPACE$(LEN.HASH.FIELD - LEN(HASH.TO.LOOK.FOR$))
  668.       CALL HASHRBBS (HASH.TO.LOOK.FOR$,MAX.POSITION,POS.TO.USE,DF)
  669.       Y$ = INDIV.TO.LOOK.FOR$ + SPACE$(LEN.INDIV.FIELD - LEN(INDIV.TO.LOOK.FOR$))
  670.       POS.TO.RECLAIM = 0
  671. 12610 GET 5,POS.TO.USE
  672.       IF EC > 0 THEN _
  673.          IF EC = 63 THEN _
  674.             EC = O : _
  675.             GOTO 12621 _
  676.          ELSE EC = 0 : _
  677.          GOTO 12620
  678.       HASH.VALUE$ = MID$(FILLER$,START.HASH.POS,LEN.HASH.FIELD)
  679.       IF X$ = HASH.VALUE$ THEN _
  680.          IF START.INDIV.POS < 1 THEN _
  681.            WHETHER.FOUND = TRUE : _
  682.            GOTO 12622 _
  683.          ELSE INDIV.VALUE$ = MID$(FILLER$,START.INDIV.POS,LEN.INDIV.FIELD) : _
  684.               IF Y$ = INDIV.VALUE$ OR INDIV.VALUE$ = EMPTY.INDIV$ THEN _
  685.                  WHETHER.FOUND = TRUE : _
  686.                  GOTO 12622
  687.       IF HASH.VALUE$ = EMPTY.REC$ THEN _
  688.          POS.TO.USE = POS.TO.RECLAIM - (POS.TO.RECLAIM = 0) * POS.TO.USE : _
  689.          WHETHER.FOUND = FALSE : _
  690.          GOTO 12622
  691.       IF ASC(HASH.VALUE$) = 0 OR INSTR(HASH.VALUE$,NEWUSER$) = 1 THEN _
  692.          IF POS.TO.RECLAIM = 0 THEN _
  693.             POS.TO.RECLAIM = POS.TO.USE
  694. 12620 POS.TO.USE = POS.TO.USE + DF
  695.       IF POS.TO.USE > MAX.POSITION - 1 THEN _
  696.          POS.TO.USE = POS.TO.USE - MAX.POSITION
  697.       GOTO 12610
  698. 12621 IF POS.TO.RECLAIM = 0 THEN _
  699.          POS.TO.RECLAIM = POS.TO.USE
  700.       GOTO 12620
  701. 12622 END SUB
  702. ' $SUBTITLE: 'UPDTCALR - subroutine to write to CALLERS file'
  703. ' $PAGE
  704. '
  705. '  SUBROUTINE NAME    -- UPDTCALR
  706. '
  707. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  708. '                        ERRMES$                   MESSAGE TO GO IN CALLER LOG
  709. '                        EXT.LOG              = 1  CHECK FOR EXTENDED LOGGING
  710. '                                                  BEFORE UPDATING.
  711. '                                             = 2  UPDATE CALLER LOG WITH Z$
  712. '
  713. '  OUTPUT PARAMETERS  -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  714. '                        TIM$                    CURRENT TIME (I.E. 1:13 PM)
  715. '                        TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  716. '
  717. '  SUBROUTINE PURPOSE -- TO UPDATE THE CALLER'S FILE AND/OR PRINT ON THE
  718. '                        LOCAL PRINTER IF IT IS ENABLED
  719. '
  720.       SUB UPDTCALR (ERRMES$,EXT.LOG) STATIC
  721.       ON ERROR GOTO 65000
  722.       IF CALLERS.FILE$ = "" OR (LOCAL.USER AND SYSOP) THEN _
  723.          EXIT SUB
  724.       X$ = "     " + ERRMES$
  725. 13663 EC = 0
  726.       FIELD 4, 64 AS CALLERS.RECORD$
  727.       IF EC > 0 THEN _
  728.          CALL QTPUT ("Caller's file:  error"+STR$(EC),1) : _
  729.          EC = 0 : _
  730.          EXIT SUB
  731.       ON EXT.LOG GOTO 13665,13670
  732. '
  733. ' ****  EXTENDED LOGGING ENTRY  ****
  734. '
  735. 13665 IF NOT EXTENDED.LOGGING THEN _
  736.          EXIT SUB
  737.       SUBROUTINE.PARAMETER = 2
  738.       CALL AMORPM
  739.       X$ = X$ + " at " + TIM$
  740. '
  741. ' ****  UPDATE CALLERS FILE WITH USER ACTIVITY  ****                                  *
  742. '
  743. 13670 LSET CALLERS.RECORD$ = X$
  744.       CALL PRINTIT (CALLERS.RECORD$)
  745.       IF LOCAL.USER AND PRINTER THEN _
  746.          EXIT SUB
  747.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  748.       PUT 4,CALLERS.FILE.INDEX!
  749.       END SUB
  750. ' $SUBTITLE: 'PRINTIT - subroutine to print on the local PC's printer'
  751. ' $PAGE
  752. '
  753. '  SUBROUTINE NAME    -- PRINTIT
  754. '
  755. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  756. '                             STRNG$             STRING TO WRITE TO THE PRINTER
  757. '
  758. '  OUTPUT PARAMETERS  -- NONE
  759. '
  760. '  SUBROUTINE PURPOSE -- TO WRITE TO THE PRINTER ATTACHED TO THE PC RUNNING
  761. '                        RBBS-PC AND TOGGLE THE PRINTER SWTICH OFF WHENEVER
  762. '                        THE PRINTER IS/BECOMES UNAVAILABLE
  763. '
  764.       SUB PRINTIT (STRNG$) STATIC
  765.       ON ERROR GOTO 65000
  766. 13674 IF PRINTER THEN _
  767.          LPRINT STRNG$
  768.       END SUB
  769. ' $SUBTITLE: 'CHANGEDIR - subroutine to change subdirectories'
  770. ' $PAGE
  771. '
  772. '  SUBROUTINE NAME    -- CHANGEDIR
  773. '
  774. '  INPUT PARAMETERS   -- PARAMETER                    MEANING
  775. '                        DIRECTORY$              NAME OF SUBDIRECTORY
  776. '
  777. '  OUTPUT PARAMETERS  -- OK                      TRUE IF CHDIR SUCCESSFUL
  778. '                        EC                      ERROR CODE
  779. '
  780. '  SUBROUTINE PURPOSE -- CHANGE SUBDIRECTORY
  781. '
  782.       SUB CHANGEDIR (DIRECTORY$) STATIC
  783.       ON ERROR GOTO 65000
  784.       EC = 0
  785.       OK = TRUE
  786. 20103 CHDIR DIRECTORY$
  787.       END SUB
  788. ' $SUBTITLE: 'FINDIT - subroutine to find if a file exists'
  789. ' $PAGE
  790. '
  791. '  SUBROUTINE NAME    -- FINDIT
  792. '
  793. '  INPUT PARAMETERS   -- PARAMETER                    MEANING
  794. '                        FILNAME$                NAME OF FILE TO FIND
  795. '
  796. '  OUTPUT PARAMETERS  -- OK                      TRUE IF FILE EXISTS
  797. '                        EC                      ERROR CODE
  798. '
  799. '  SUBROUTINE PURPOSE -- DETERMINE IF A FILE EXISTS BY RENAMING IT TO ITSELF
  800. '
  801.       SUB FINDIT (FILNAME$) STATIC
  802.       ON ERROR GOTO 65000
  803.       EC = 0
  804.       OK = FALSE
  805.       IF LEN(FILNAME$) < 1 THEN _
  806.          EXIT SUB
  807.       IF TURBO.RBBS THEN _
  808.          CALL FINDFILE (FILNAME$,OK) : _
  809.          IF OK THEN _
  810.             GOTO 20222 _
  811.          ELSE EXIT SUB
  812. 20221 CALL BADFILECHAR (FILNAME$,OK)
  813.       IF NOT OK THEN _
  814.          EXIT SUB
  815.       OK = FALSE
  816.       NAME FILNAME$ AS FILNAME$
  817.       IF EC = 53 THEN _
  818.          EXIT SUB
  819. 20222 CLOSE 2
  820. 20223 OPEN "I",2,FILNAME$
  821.       IF EC = 64 OR EC = 76 THEN _
  822.          EXIT SUB
  823.       OK = TRUE
  824.       END SUB
  825. ' $SUBTITLE: 'FLUSHCOM -- subroutine reads all char. from  comm. port'
  826. ' $PAGE
  827. '
  828. '  SUBROUTINE NAME    -- FLUSHCOM
  829. '
  830. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  831. '                          STNG$       STRING TO READ CHARACTERS INTO FROM
  832. '                                      THE COMMUNICATIONS PORT (FILE #3)
  833. '
  834. '  OUTPUT PARAMETERS  --   STNG$
  835. '
  836. '  SUBROUTINE PURPOSE -- READS ALL CHARACTER FROM FROM THE COMMUNICATIONS PORT.
  837. '
  838.       SUB FLUSHCOM (STRNG$) STATIC
  839.       ON ERROR GOTO 65000
  840.       IF LOCAL.USER THEN _
  841.          EXIT SUB
  842.       STRNG$ = ""
  843.       IF NOT FOSSIL THEN _
  844.          GOTO 20311
  845. 20310 CALL FOSREADAHEAD(COMPORT%,CHAR%)
  846.       IF CHAR% <> -1 THEN _
  847.          CALL FOSRXCHAR(COMPORT%,CHAR%) : _
  848.          STRNG$ = STRNG$ + CHR$(CHAR%) : _
  849.          GOTO 20310
  850.       EXIT SUB
  851. 20311 STRNG$ = INPUT$(LOC(3),3)                     ' FLUSH THE COMM BUFFER
  852. 20312 IF EC = 57 THEN _
  853.          LINE.STATUS = INP(LINE.STATUS.REGISTER) : _
  854.          EC = 0 : _
  855.          GOTO 20311
  856.       END SUB
  857. ' $SUBTITLE: 'NETBIOS - subroutine to lock/unlock using NETBIOS'
  858. ' $PAGE
  859. '
  860. '  SUBROUTINE NAME    -- NETBIOS   (WRITTEN BY DOUG AZZARITO)
  861. '
  862. '  INPUT PARAMETERS   -- IBM.LOCK.CMD       = 1-LOCK, 0-UNLOCK
  863. '                        IBM.FILE.LOCK      = 5 USERS FILE
  864. '                                           = 6 SEMAPHORE FILE
  865. '                        IBM.RECORD.LOCK    = RECORD NUMBER TO LOCK
  866. '
  867. '  OUTPUT PARAMETERS  -- NONE
  868. '
  869. '  SUBROUTINE PURPOSE -- LOCK AND UNLOCK FILES USING NETBIOS CMNDS.
  870. '                        IF LOCK FAILS, THIS ROUTINE TRIES FOREVER.
  871. '
  872.       SUB NETBIOS (IBM.LOCK.CMD,IBM.FILE.LOCK,IBM.RECORD.LOCK) STATIC
  873.       STATIC IBMCOUNT                                                ' debug
  874.       ON ERROR GOTO 65000
  875. 29900 ON IBM.LOCK.CMD + 1 GOTO 29920, 29910
  876.       EXIT SUB
  877. '
  878. ' *****  LOCK LOOP   *****
  879. '
  880. 29910 EC = 0
  881.       XROW = CSRLIN                                                  ' DEBUG
  882.       XCOL = POS(0)                                                  ' DEBUG
  883.       LOCATE 25,1                                                    ' debug
  884. '     PRINT "LOCK=";IBM.FILE.LOCK;",";IBM.RECORD.LOCK;
  885.       LOCATE XROW, XCOL                                              ' debug
  886.       IF IBM.FILE.LOCK = 6 AND IBM.RECORD.LOCK = 3 THEN _
  887.          IBMCOUNT = IBMCOUNT + 1 : _
  888.          IF IBMCOUNT > 1 THEN _
  889.             EXIT SUB
  890.       LOCK IBM.FILE.LOCK, IBM.RECORD.LOCK TO IBM.RECORD.LOCK
  891.       IF EC <> 0 THEN _
  892.          GOTO 29910
  893.       EXIT SUB
  894. 29920 EC = 0
  895.       XROW = CSRLIN                                                  ' DEBUG
  896.       XCOL = POS(0)                                                  ' DEBUG
  897.       LOCATE 25,15                                                   ' debug
  898. '     PRINT "UNLK=";IBM.FILE.LOCK;",";IBM.RECORD.LOCK;
  899.       LOCATE XROW,XCOL                                               ' debug
  900.       IF IBM.FILE.LOCK = 6 AND IBM.RECORD.LOCK = 3 THEN _
  901.          IBMCOUNT = IBMCOUNT - 1 : _
  902.          IF IBMCOUNT > 0 THEN _
  903.             EXIT SUB _
  904.          ELSE IBMCOUNT = 0
  905.       UNLOCK IBM.FILE.LOCK, IBM.RECORD.LOCK TO IBM.RECORD.LOCK
  906.       IF EC <> 0 THEN _
  907.          GOTO 29920
  908.       END SUB
  909. ' $SUBTITLE: 'UPDATEC - update of callers log on exiting'
  910. ' $PAGE
  911. '
  912. '  SUBROUTINE NAME    -- UPDATEC
  913. '
  914. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  915. '                        CALLERS.FILE.INDEX!
  916. '                        FIRST.NAME$
  917. '                        HHH
  918. '                        LAST.NAME$
  919. '                        MMM
  920. '                        NG$
  921. '                        SSS
  922. '                        SYSOP.FIRST.NAME$
  923. '                        SYSOP.LAST.NAME$
  924. '
  925. '  OUTPUT PARAMETERS  -- CALLERS.RECORD$
  926. '                        CALLERS.FILE.INDEX!
  927. '                        SYSOP
  928. '
  929. '  SUBROUTINE PURPOSE -- UPDATE THE CALLERS FILE AT LOGOFF SO THAT THE NUMBER
  930. '                        OF HOURS, MINUTES, AND SECONDS FOR THE SESSION ARE
  931. '                        RECORDED AS THE LAST 9 CHARACTERS OF THE 64-CHARACTER
  932. '                        CALLERS FILE RECORD
  933. '
  934.       SUB UPDATEC STATIC
  935.       ON ERROR GOTO 65000
  936.       IF CALLERS.FILE$ = "" THEN _
  937.          EXIT SUB
  938. '
  939. ' ****  UPDATE CALLERS FILE AT LOGOFF  ****
  940. '
  941. 43050 FIELD 4,55 AS CALLERS.RECORD$,3 AS HOURS$,3 AS MINUTES$,3 AS SECONDS$
  942.       LSET CALLERS.RECORD$ = MID$(NG$,65,55)
  943.       LSET HOURS$ = STR$(HHH)
  944.       LSET MINUTES$ = STR$(MMM)
  945.       LSET SECONDS$ = STR$(SSS)
  946.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  947.       PUT 4,CALLERS.FILE.INDEX!
  948.       FIELD 4,64 AS CALLERS.RECORD$
  949.       LSET CALLERS.RECORD$ = LEFT$(NG$,64)
  950.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  951.       PUT 4,CALLERS.FILE.INDEX!
  952. 43060 LSET CALLERS.RECORD$ = STRING$(64,CHR$(0))
  953.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  954.       PUT 4,CALLERS.FILE.INDEX!
  955.       CALLERS.FILE.INDEX! = CALLERS.FILE.INDEX! + 1
  956.       PUT 4,CALLERS.FILE.INDEX!
  957.       IF ORIG.CALLERS$ <> CALLERS.FILE$ THEN _
  958.          CALLERS.FILE$ = ORIG.CALLERS$ : _
  959.          CALL SETCALL : _
  960.          GOTO 43050
  961. '      SYSOP = (FIRST.NAME$ = SYSOP.FIRST.NAME$ AND _
  962. '         LAST.NAME$ = SYSOP.LAST.NAME$)
  963.       END SUB
  964. ' $SUBTITLE: 'FINDFREE - subroutine to find space on a device'
  965. ' $PAGE
  966. '
  967. '  SUBROUTINE NAME    -- FINDFREE
  968. '
  969. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  970. '                        Z$                        NAME OF FILE TO FIND
  971. '
  972. '  OUTPUT PARAMETERS  -- FREE.SPACE$               NUMBER OF BYTES FREE
  973. '
  974. '  SUBROUTINE PURPOSE -- TO DETERMINE AMOUNT OF FREE SPACE ON A DEVICE
  975. '
  976.       SUB FINDFREE STATIC
  977.       ON ERROR GOTO 65000
  978.       EC = 0
  979. 52000 IF TURBO.RBBS THEN _
  980.          GOTO 52003
  981.       FREE.SPACE$ = ""
  982.       CLS
  983.       EC = 0
  984. 52001 FILES Z$
  985.       IF EC = 53 AND (Z$ = COMMENTS.FILE$ OR Z$ = UPLOAD.DRIVE.FILE$ ) THEN _
  986.          CALL OPENOUTW (Z$) : _
  987.          GOTO 52000
  988.       IF EC = 53 AND Z$ = UPLOAD.DIRECTORY$ THEN _
  989.          A$ = "Upload directory missing.  Tell SYSOP" : _
  990.          SUBROUTINE.PARAMETER = 6 : _
  991.          CALL TPUT : _
  992.          GOTO 52002
  993.       FOR X = 1 TO 25
  994.          FREE.SPACE$ = FREE.SPACE$ + CHR$(SCREEN (3,X))
  995.       NEXT
  996. 52002 SUBROUTINE.PARAMETER = 1
  997.       CALL LINE25
  998.       EXIT SUB
  999. 52003 AX% = 0
  1000.       BX% = 0
  1001.       CX% = 0
  1002.       DX% = 0
  1003.       IF MID$(Z$,2,1) = ":" THEN _
  1004.          AX% = ASC(Z$) - ASC("A") + 1
  1005.       CALL RBBSFREE (AX%,BX%,CX%,DX%)
  1006.       I# = CDBL(AX%) * BX%
  1007.       I# = I# * CX%
  1008.       FREE.SPACE$ = STR$(I#) + _
  1009.                     " bytes free"
  1010.       END SUB
  1011. ' $SUBTITLE: 'OPENWORK - subroutine to open RBBS-PC's work file (2)'
  1012. ' $PAGE
  1013. '
  1014. '  SUBROUTINE NAME    -- OPENWORK
  1015. '
  1016. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1017. '                        FILE.NAME$                NAME OF FILE TO FIND
  1018. '                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1019. '
  1020. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1021. '
  1022. '  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2)
  1023. '
  1024.       SUB OPENWORK (FILNAME$) STATIC
  1025.       ON ERROR GOTO 65000
  1026. 58000 CLOSE 2
  1027. 58010 EC = 0
  1028. 58020 IF SHARE.IT THEN _
  1029.          OPEN FILNAME$ FOR INPUT SHARED AS #2 _
  1030.       ELSE OPEN "I",2,FILNAME$
  1031.       IF EC = 52 THEN _
  1032.          GOTO 58010
  1033. 58030 END SUB
  1034. ' $SUBTITLE: 'OPENFMS - subroutine to open the FMS directory'
  1035. ' $PAGE
  1036. '
  1037. '  SUBROUTINE NAME    -- OPENFMS
  1038. '
  1039. '  INPUT PARAMETERS   -- PARAMETER                      MEANING
  1040. '                        SHARE.IT                DOS SHARING FLAG
  1041. '                        FMS.DIRECTORY$        NAME OF FMS DIRECTORY
  1042. '
  1043. '  OUTPUT PARAMETERS  -- LAST.REC                NUMBER OF THE LAST
  1044. '                                                RECORD IN THE FILE
  1045. '
  1046. '  SUBROUTINE PURPOSE -- TO OPEN THE UPLOAD DIRECTORY AS A RANDOM FILE AND FIND
  1047. '                        THE NUMBER OF THE LAST RECORD IN THE FILE.
  1048. '
  1049.       SUB OPENFMS (LAST.REC) STATIC
  1050. 58190 ON ERROR GOTO 65000
  1051.       FILE.LENGTH = 38 + MAX.DESC.LEN
  1052.       CLOSE 2
  1053.       IF ACTIVE.FMS.DIRECTORY$ = "" THEN _
  1054.          IF MENU.INDEX = 6 THEN _
  1055.             ACTIVE.FMS.DIRECTORY$ = LIBRARY.DIRECTORY$ _
  1056.          ELSE ACTIVE.FMS.DIRECTORY$ = FMS.DIRECTORY$
  1057.       IF SHARE.IT THEN _
  1058.          OPEN ACTIVE.FMS.DIRECTORY$ FOR RANDOM SHARED AS #2 LEN=FILE.LENGTH _
  1059.       ELSE OPEN "R",2,ACTIVE.FMS.DIRECTORY$,FILE.LENGTH
  1060.       IF EC > 0 THEN _
  1061.          CALL QTPUT ("Drive/path does not exist or bad name for FMS dir " + _
  1062.                      ACTIVE.FMS.DIRECTORY$,1) : _
  1063.          END
  1064.       LAST.REC = LOF(2)/FILE.LENGTH
  1065.       IF ACTIVE.FMS.DIRECTORY$ = PREV.FMS$ THEN _
  1066.          EXIT SUB
  1067.       PREV.FMS$ = ACTIVE.FMS.DIRECTORY$
  1068.       FIELD 2, FILE.LENGTH AS FMS.REC$
  1069.       GET #2,1
  1070.       A = (LEFT$(FMS.REC$,4) <> "\FMS")
  1071.       UPINC = 2*(INSTR(FMS.REC$," TOP ") = 0 OR A) + 1
  1072.       DATE.ORDERED.FMS = A OR (INSTR(FMS.REC$," NOSORT") = 0)
  1073.       END SUB
  1074. ' $SUBTITLE: 'OPENOUTW - subroutine to open output work file (2)'
  1075. ' $PAGE
  1076. '
  1077. '  SUBROUTINE NAME    -- OPENOUTW
  1078. '
  1079. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1080. '                        FILE.NAME$                NAME OF FILE TO FIND
  1081. '                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1082. '
  1083. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1084. '
  1085. '  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2) FOR OUTPUT
  1086. '
  1087.       SUB OPENOUTW (FILNAME$) STATIC
  1088.       ON ERROR GOTO 65000
  1089. 58220 CLOSE 2
  1090. 58225 EC = 0
  1091. 58230 IF SHARE.IT THEN _
  1092.          OPEN FILNAME$ FOR OUTPUT SHARED AS #2 _
  1093.       ELSE OPEN "O",2,FILNAME$
  1094. 58235 END SUB
  1095. ' $SUBTITLE: 'KILLWORK - subroutine to delete a "work" file'
  1096. ' $PAGE
  1097. '
  1098. '  SUBROUTINE NAME    -- KILLWORK
  1099. '
  1100. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1101. '                        FILE.NAME$                NAME OF FILE TO DELETE
  1102. '
  1103. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1104. '
  1105. '  SUBROUTINE PURPOSE -- TO DELETE A RBBS-PC "WORK" FILE
  1106. '
  1107.       SUB KILLWORK (FILE.NAME$) STATIC
  1108.       ON ERROR GOTO 65000
  1109. 58260 CLOSE 2
  1110. 58265 EC = 0
  1111. 58270 KILL FILE.NAME$
  1112. 58275 END SUB
  1113. ' $SUBTITLE: 'GETPASWD - subroutine to read the "passwords" file'
  1114. ' $PAGE
  1115. '
  1116. '  SUBROUTINE NAME    -- GETPASWD
  1117. '
  1118. '                          PARAMETER             MEANING
  1119. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1120. '
  1121. '  OUTPUT PARAMETERS  -- TEMP.PASSWORD$
  1122. '                        TEMP.SECURITY.LEVEL
  1123. '                        TEMP.TIME.ALLOWED
  1124. '                        TEMP.REG.PERIOD
  1125. '                        TEMP.MAX.PER.DAY
  1126. '
  1127. '  SUBROUTINE PURPOSE -- TO READ THE RBBS-PC "PASSWORDS" FILE
  1128. '
  1129. 58280 SUB GETPASWD STATIC
  1130.       ON ERROR GOTO 65000
  1131.       EC = 0
  1132.       INPUT #2,TEMP.PASSWORD$,     TEMP.SECURITY.LEVEL, _
  1133.                TEMP.TIME.ALLOWED,  TEMP.MAX.PER.DAY, _
  1134.                TEMP.REG.PERIOD,    START.TIME, _
  1135.                END.TIME,           BYTE.METHOD, _
  1136.                RATIO.RESTRICTION#, INITIAL.CREDIT#, _
  1137.                TEMP.TIME.LOCK
  1138. 58285 END SUB
  1139. ' $SUBTITLE: 'READDIR - subroutine to read the "DIR" files'
  1140. ' $PAGE
  1141. '
  1142. '  SUBROUTINE NAME    -- READDIR
  1143. '
  1144. '                          PARAMETER             MEANING
  1145. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1146. '                        WHICH.LINE              HOW MANY LINES TO ADVANCE
  1147. '
  1148. '  OUTPUT PARAMETERS  -- A$
  1149. '
  1150. '  SUBROUTINE PURPOSE -- TO READ POSSIBLE "DIR" FILES
  1151. '
  1152. 58290 SUB READDIR (WHICH.LINE) STATIC
  1153.       ON ERROR GOTO 65000
  1154.       EC = 0
  1155.       FOR I = 1 TO WHICH.LINE
  1156.          LINE INPUT #2,A$
  1157.       NEXT
  1158. 58295 END SUB
  1159. ' $SUBTITLE: 'READPARMS - subroutine to read parameter values'
  1160. ' $PAGE
  1161. '
  1162. '  SUBROUTINE NAME    -- READPARMS
  1163. '
  1164. '                          PARAMETER             MEANING
  1165. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1166. '                        NUM.PARMS               # parameters to read
  1167. '                        WHICH.LINE              Which set of parms to return
  1168. '  OUTPUT PARAMETERS  -- ARA.TO.USER$            Array of string values
  1169. '                        FILE.SECURITY
  1170. '                        FILE.PASSWORD$
  1171. '
  1172. '  SUBROUTINE PURPOSE -- To read different values, where values are
  1173. '                        separated by a comma or carriage-return-line-feed.
  1174. '
  1175. 58300 SUB READPARMS (ARA.TO.USE$(1),NUM.PARMS,WHICH.LINE) STATIC
  1176.       ON ERROR GOTO 65000
  1177.       EC = 0
  1178.       FOR J = 1 TO WHICH.LINE
  1179.          FOR I = 1 TO NUM.PARMS
  1180.             INPUT #2,ARA.TO.USE$(I)
  1181.          NEXT
  1182.       NEXT
  1183. 58305 END SUB
  1184. ' $SUBTITLE: 'READANY - subroutine to read file 2 into A$'
  1185. ' $PAGE
  1186. '
  1187. '  SUBROUTINE NAME    -- READANY
  1188. '
  1189. '                          PARAMETER             MEANING
  1190. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1191. '
  1192. '  OUTPUT PARAMETERS  -- A$
  1193. '
  1194. '  SUBROUTINE PURPOSE -- TO READ FILE #2 INTO A$
  1195. '
  1196. 58310 SUB READANY STATIC
  1197.       ON ERROR GOTO 65000
  1198.       EC = 0
  1199.       INPUT #2,A$
  1200. 58315 END SUB
  1201. ' $SUBTITLE: 'PRINTWRK - subroutine to print to file 2'
  1202. ' $PAGE
  1203. '
  1204. '  SUBROUTINE NAME    -- PRINTWRK
  1205. '
  1206. '                          PARAMETER             MEANING
  1207. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1208. '                        STRING TO WRITE OUT
  1209. '
  1210. '  OUTPUT PARAMETERS  -- NONE
  1211. '
  1212. '  SUBROUTINE PURPOSE -- TO PRINT A STRING TO FILE #2
  1213. '
  1214. 58320 SUB PRINTWRK (STRNG$) STATIC
  1215.       ON ERROR GOTO 65000
  1216.       EC = 0
  1217.       PRINT #2,STRNG$;
  1218. 58325 END SUB
  1219. ' $SUBTITLE: 'GETWORK - subroutine to read file 2'
  1220. ' $PAGE
  1221. '
  1222. '  SUBROUTINE NAME    -- GETWORK
  1223. '
  1224. '                          PARAMETER             MEANING
  1225. '  INPUT PARAMETERS   -- REC.LEN            Length of record
  1226. '
  1227. '  OUTPUT PARAMETERS  -- NONE
  1228. '
  1229. '  SUBROUTINE PURPOSE -- TO READ A RECORD FROM FILE #2
  1230. '
  1231. 58330 SUB GETWORK (REC.LEN) STATIC
  1232.       ON ERROR GOTO 65000
  1233.       EC = 0
  1234.       FIELD 2, REC.LEN AS DOWNLOAD.RECORD$
  1235.       GET 2,(LOC(2)+1)
  1236. 58335 END SUB
  1237. ' $SUBTITLE: 'OPENWRKA - subroutine to open output work file (2)'
  1238. ' $PAGE
  1239. '
  1240. '  SUBROUTINE NAME    -- OPENWRKA
  1241. '
  1242. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1243. '                        FILNAME$                  NAME OF FILE TO FIND
  1244. '                        SHARE.IT                  USE DOS' "SHARE" FACILITIES
  1245. '
  1246. '  OUTPUT PARAMETERS  -- EC                        ERROR CODE
  1247. '
  1248. '  SUBROUTINE PURPOSE -- TO OPEN RBBS-PC'S "WORK" FILE (NUMBER 2) FOR APPENDED
  1249. '                        OUTPUT
  1250. '
  1251. 58340 SUB OPENWRKA (FILNAME$) STATIC
  1252.       ON ERROR GOTO 65000
  1253.       CLOSE 2
  1254.       EC = 0
  1255.       IF SHARE.IT THEN _
  1256.          OPEN FILNAME$ FOR APPEND SHARED AS #2 _
  1257.       ELSE OPEN "A",2,FILNAME$
  1258. 58345 END SUB
  1259. ' $SUBTITLE: 'PRNTWRKA - subroutine to print to file 2 with CR'
  1260. ' $PAGE
  1261. '
  1262. '  SUBROUTINE NAME    -- PRNTWRKA
  1263. '
  1264. '                          PARAMETER             MEANING
  1265. '  INPUT PARAMETERS   -- FILE # 2 OPENED
  1266. '                        STRING TO WRITE OUT
  1267. '
  1268. '  OUTPUT PARAMETERS  -- NONE
  1269. '
  1270. '  SUBROUTINE PURPOSE -- TO PRINT A STRING TO FILE #2 FOLLOWED BY A CARRIAGE
  1271. '                        RETURN
  1272. '
  1273. 58350 SUB PRNTWRKA (STRNG$) STATIC
  1274.       ON ERROR GOTO 65000
  1275.       EC = 0
  1276.       PRINT #2,STRNG$
  1277. 58355 END SUB
  1278. ' $SUBTITLE: 'CHECKINT - subroutine to check input is an integer'
  1279. ' $PAGE
  1280. '
  1281. '  SUBROUTINE NAME    -- CHECKINT
  1282. '
  1283. '                          PARAMETER             MEANING
  1284. '  INPUT PARAMETERS   -- STRNG$         STRING TO VERIFY CAN BE AN INTEGER
  1285. '
  1286. '  OUTPUT PARAMETERS  -- EC             = 0 MEANS IT IS AN INTEGER VALUE
  1287. '                                      <> 0 MEANS IT IS NOT AN INTEGER VALUE
  1288. '
  1289. '  SUBROUTINE PURPOSE -- TO PRINT VALIDATE A STRING CAN HAVE AN INTEGER VALUE
  1290. '
  1291. 58360 SUB CHECKINT (STRNG$) STATIC
  1292.       ON ERROR GOTO 65000
  1293.       EC = 0
  1294.       TESTED.INTEGER.VALUE = VAL(STRNG$)
  1295. 58365 END SUB
  1296. ' $SUBTITLE: 'PUTCOM -- subroutine to write to communications port'
  1297. ' $PAGE
  1298. '
  1299. '  SUBROUTINE NAME    -- PUTCOM
  1300. '
  1301. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  1302. '                          STNG$       STRING TO PRINT TO COMM PORT
  1303. '                        FLOW.CONTROL  WHETHER USING CLEAR TO SEND FOR FLOW
  1304. '                                      CONTROL BETWEEN THE PC AND THE MODEM
  1305. '
  1306. '  OUTPUT PARAMETERS  --
  1307. '
  1308. '  SUBROUTINE PURPOSE -- CHECKS FOR CARRIER DROP AND FLOW CONTROL (I.E. "CLEAR
  1309. '                        TO SEND" SIGNAL) BEFORE WRITING TO THE COMMUNICATIONS
  1310. '                        PORT.
  1311. '
  1312. 59650 SUB PUTCOM (STRNG$) STATIC
  1313.       ON ERROR GOTO 65000
  1314.       IF LOCAL.USER THEN _
  1315.          EXIT SUB
  1316.       CALL CARRIER
  1317.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1318.          EXIT SUB
  1319.       IF NOT XOFF.ED THEN _
  1320.          GOTO 59652
  1321.       SUBROUTINE.PARAMETER = 1
  1322.       CALL LINE25
  1323.       Y$ = XOFF$
  1324.       CALL SETABORT (X!,WAIT.BEFORE.DISCONNECT)
  1325.       WHILE Y$ = XOFF$ AND SUBROUTINE.PARAMETER <> -1
  1326.          CHAR% = -1
  1327.          WHILE CHAR% = -1 AND SUBROUTINE.PARAMETER <> -1
  1328.             GOSUB 59654
  1329.          WEND
  1330.          IF CHAR% <> -1 THEN _
  1331.             CALL GETCOM(Y$) : _
  1332.             IF XON.XOFF AND Y$ <> XON$ THEN _
  1333.                Y$ = XOFF$
  1334.       WEND
  1335.       XOFF.ED = FALSE
  1336.       SUBROUTINE.PARAMETER = 1
  1337.       CALL LINE25
  1338. 59652 NOT.CTS = FALSE
  1339.       IF NOT FOSSIL THEN _
  1340.          PRINT #3,STRNG$; : _
  1341.          EXIT SUB
  1342.       IF STRNG$ = "" THEN _
  1343.          EXIT SUB
  1344.       FOR N = 1 TO LEN(STRNG$)
  1345.           CHAR% = ASC(MID$(STRNG$,N,1))
  1346. 59653     CALL FOSTXCHARNW(COMPORT%,CHAR%,RESULT%)
  1347.           IF RESULT% = 0 THEN _
  1348.              GOTO 59653
  1349.       NEXT
  1350.       EXIT SUB
  1351. 59654 CALL EOFCOMM (CHAR%)
  1352.       CALL GOIDLE
  1353.       CALL CARRIER
  1354.       CALL CHKTREMAIN (X!)
  1355.       RETURN
  1356.       END SUB
  1357. ' $SUBTITLE: 'PUTWORK -- subroutine to write to upload files'
  1358. ' $PAGE
  1359. '
  1360. '  SUBROUTINE NAME    -- PUTWORK
  1361. '
  1362. '  INPUT PARAMETERS   --   PARAMETER     MEANING
  1363. '                          STNG$       STRING TO WRITE TO FILE
  1364. '                          REC.NUM     RECORD NUMBER TO WRITE
  1365. '                          REC.LEN     LENGTH OF RECORD TO WRITE
  1366. '
  1367. '  OUTPUT PARAMETERS  --
  1368. '
  1369. '  SUBROUTINE PURPOSE -- WRITES UPLOADED FILE RECORDS TO WORK FILE
  1370. '
  1371. 59660 SUB PUTWORK (STRNG$,REC.NUM,REC.LEN) STATIC
  1372.       ON ERROR GOTO 65000
  1373.       FIELD #2,REC.LEN AS UPLOAD.RECORD$
  1374.       LSET UPLOAD.RECORD$ = STRNG$
  1375.       REC.NUM = REC.NUM + 1
  1376.       PUT #2,REC.NUM
  1377.       END SUB
  1378. '  $SUBTITLE: 'Error Handling for separately compiled subroutines'
  1379. '  $PAGE
  1380. '
  1381. ' *****************************************************************************
  1382. ' *  Error handling for the separately compiled subroutines of RBBS-PC        *
  1383. ' *****************************************************************************
  1384. '
  1385. 65000 IF DEBUG THEN _
  1386.          A$ = "RBBSSUB1 DEBUG Error Trap Entry ERL=" + _
  1387.               STR$(ERL) + _
  1388.               " ERR=" + _
  1389.               STR$(ERR) : _
  1390.          IF PRINTER THEN _
  1391.             CALL PRINTIT(A$) _
  1392.          ELSE CALL LPRNT(A$,1)
  1393.       EC = ERR
  1394. '
  1395. '     SETCALL
  1396. '
  1397.       IF ERL = 110 THEN _
  1398.           RESUME NEXT
  1399. '
  1400. '     OPEN CONFIG FILE
  1401. '
  1402.        IF ERL => 117 AND ERL <= 118 THEN _
  1403.           RESUME NEXT
  1404. '
  1405. '     OPEN COM PORT ERROR HANDLING
  1406. '
  1407.       IF ERL = 200 THEN _
  1408.          CLS : _
  1409.          CALL LPRNT("Fatal error opening " + COM.PORT$,1) : _
  1410.          CALL LPRNT ("DOS ERROR=" + STR$(ERR),1) : _
  1411.          STOP
  1412. '
  1413. '     GETCOM ERROR HANDLING
  1414. '
  1415.        IF ERL = 1420 AND ERR = 57 THEN _
  1416.           RESUME NEXT
  1417.        IF ERL = 1420 AND ERR = 69 THEN _
  1418.           SUBROUTINE.PARAMETER = -1 :_
  1419.           RESUME NEXT
  1420. '
  1421. '      OPENRESEQ ERROR HANDLING
  1422. '
  1423.        IF ERL = 1481 THEN _
  1424.            EC = ERR : _
  1425.            RESUME NEXT
  1426. '
  1427. '      OPENUSER ERROR HANDLING
  1428. '
  1429.        IF ERL = 9400 AND ERR = 75 AND SHARE.IT THEN _
  1430.           CALL DELAYIT (30) : _
  1431.           RESUME
  1432. '
  1433. '      FINDUSER ERROR HANDLING
  1434. '
  1435.        IF ERL = 12610 THEN _
  1436.           RESUME NEXT
  1437. '
  1438. '     UPDTCALR ERROR HANDLING
  1439. '
  1440.        IF ERL = 13663 THEN _
  1441.           RESUME NEXT
  1442.        IF ERL = 13670 AND ERR = 61 THEN _
  1443.           CALL QTPUT ("Disk Full",1) : _
  1444.           IF DISKFULL.GO.OFFLINE THEN _
  1445.              GOTO 65010 _
  1446.           ELSE RESUME NEXT
  1447. '
  1448. '     PRINTER ERROR HANDLING
  1449. '
  1450.        IF ERL = 13674 THEN _
  1451.           PRINTER = FALSE : _
  1452.           RESUME
  1453. '
  1454. '      CHANGEDIR ERROR HANDLING
  1455. '
  1456.        IF ERL = 20103 THEN _
  1457.           OK = FALSE : _
  1458.           RESUME NEXT
  1459. '
  1460. '     FINDIT ERROR HANDLING
  1461. '
  1462.        IF ERL = 20221 THEN _
  1463.           RESUME NEXT
  1464.        IF ERL = 20223 AND EC = 58 THEN _
  1465.           EC = 64 : _
  1466.           OK = FALSE : _
  1467.           RESUME NEXT
  1468.        IF ERL = 20223 AND EC = 76 THEN _
  1469.           CALL LPRNT("Bad path.  File name is " + FILNAME$,1) : _
  1470.           EC = 76 : _
  1471.           OK = FALSE : _
  1472.           RESUME NEXT
  1473.        IF ERL => 20221 AND ERL <= 20223 AND EC = 70 _
  1474.           AND NETWORK.TYPE = 6 THEN _
  1475.              EC = 0 : _
  1476.              RESUME NEXT
  1477.        IF ERL => 20221 AND ERL <= 20223 THEN _
  1478.           RESUME
  1479. '
  1480. '     FLUSHCOM ERROR HANDLING
  1481. '
  1482.        IF ERL = 20311 AND ERR = 57 THEN _
  1483.           RESUME NEXT
  1484.        IF ERL = 20311 AND ERR = 69 THEN _
  1485.           ABORT = TRUE : _
  1486.           SUBROUTINE.PARAMETER = -1 : _
  1487.           RESUME NEXT
  1488. '
  1489. '     NETBIOS ERROR HANDLING
  1490. '
  1491.        IF ERL => 29900 AND ERL <= 29920 THEN _
  1492.           RESUME NEXT
  1493. '
  1494. '     UPDATEC ERROR HANDLING
  1495. '
  1496.       IF ERL => 43050 AND ERL <= 43060 AND ERR = 61 THEN _
  1497.          A$ = "* Disk full - terminating *" : _
  1498.          SUBROUTINE.PARAMETER =2 : _
  1499.          CALL TPUT : _
  1500.          IF DISKFULL.GO.OFFLINE THEN _
  1501.            GOTO 65010 _
  1502.          ELSE SYSTEM
  1503. '
  1504. '     FINDFREE ERROR HANDLING
  1505. '
  1506. '
  1507. '     OPENWORK ERROR HANDLING
  1508. '
  1509. '
  1510. '      OPENFMS ERROR HANDLING
  1511. '
  1512. '
  1513. '     OPENOUTW ERROR HANDLING
  1514. '
  1515. '
  1516. '     KILLWORK ERROR HANDLING
  1517. '
  1518. '
  1519. '     GETPASWD ERROR HANDLING
  1520. '
  1521. '
  1522. '     READDIR ERROR HANDLING
  1523. '
  1524. '
  1525. '     READSEC ERROR HANDLING
  1526. '
  1527. '
  1528. '     READANY ERROR HANDLING
  1529. '
  1530. '
  1531. '     PRINTWRK ERROR HANDLING
  1532. '
  1533. '
  1534. '     GETWORK ERROR HANDLING
  1535. '
  1536. '
  1537. '     OPENWRKA ERROR HANDLING
  1538. '
  1539. '
  1540. '     PRNTWRKA ERROR HANDLING
  1541. '
  1542. '
  1543. '     CHECKINT ERROR HANDLING
  1544. '
  1545.        IF ERL = 59652 AND ERR = 24 THEN _
  1546.           NOT.CTS = TRUE : _
  1547.           CALL LINE25 : _
  1548.           RESUME
  1549.        IF ERL => 52000 AND ERL <= 59660 THEN _
  1550.           RESUME NEXT
  1551. '
  1552. '     CATCH ALL OTHER ERRORS
  1553. '
  1554.        A$ = "RBBS-SUB1 Untrapped Error" + _
  1555.             STR$(ERR) + _
  1556.             " in line" + _
  1557.             STR$(ERL)
  1558.        CALL QTPUT (A$,1)
  1559.        CALL UPDTCALR (A$,2)
  1560.        RESUME NEXT
  1561. '     SHARED ROUTINE FOR GOING OFF LINE WHEN DISK FULL
  1562. 65010  CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  1563.        CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  1564.        IF FOSSIL THEN _
  1565.           CALL FOSEXIT(COMPORT%)
  1566.        SYSTEM
  1567.